with Ada.Text_IO; use Ada.Text_IO;
with Ada.Numerics.Discrete_Random;
with Dll;
with Interfaces.C; use Interfaces.C;
with Ada.Strings.Unbounded; use Ada.Strings.Unbounded;
with Ada.Strings.Fixed;
with AWS;
with SSL;
with AWS.Server;
with AWS.Status;
with AWS.Response; use AWS.Response;
with AWS.MIME;
with Ada.Strings.Maps;
with Ada.Strings.Maps.Constants;
with GNAT.Regpat; use GNAT.Regpat;
with Ada.Calendar; use Ada.Calendar;
with Ada.Directories;
with Ada.Containers;
with Ada.Containers.Hashed_Maps;
with Ada.Strings;
with Ada.Strings.Hash;

procedure AdaSP_Serv is
	WS : AWS.Server.Http;
	type Type_Adasp_Finalize is access procedure;
	type AdaSP is record
		Path : Unbounded_String;
		Timestamp : Ada.Calendar.Time;
		Handle : Dll.Handle_Type;
		Do_AdaSP : AWS.Response.Callback;
	end record;
	type Adasp_Access is access AdaSP;
	Package RandInt is new Ada.Numerics.Discrete_Random(INTEGER);
	Gen : RandInt.Generator;

	function Dummy(request : In AWS.Status.Data) return AWS.Response.Data is
	begin
		return AWS.Response.Build(AWS.MIME.Text_HTML, "Dummy");
	end Dummy;

	function Build_AdaSP(path : in String) return AdaSP_Access is
		type Type_Adasp_Init is access procedure;
		Procedure Map_AdaSP_Init is new Dll.Sym(Item_Type => Type_Adasp_Init);
		Procedure Map_AdaSP_Finalize is new Dll.Sym(Item_Type => Type_Adasp_Finalize);
		Procedure Map_AdaSP is new Dll.Sym(Item_Type => AWS.Response.Callback);
		Do_Adasp : AWS.Response.Callback;
		Handle : Dll.Handle_Type;
		So_Name : Unbounded_String;
		O_Name : Unbounded_String;
		Package_Name : Unbounded_String;
		function Sys (Arg : Char_Array) return Integer;
		pragma Import(C, Sys, "system");
		Ret_Val : Integer;
		Cmd : Unbounded_String;
		Adb_File : File_Type;
		Adb_Name : Unbounded_String;
		Ads_File : File_Type;
		Ads_Name : Unbounded_String;
		Gpr_File : File_Type;
		Gpr_Name : Unbounded_String;
		Temp_Dir : Unbounded_String;
		Input_File : File_Type;
		Adasp_Body : Unbounded_String;
		Gnat_Root : Unbounded_String;
		Aws_Root : Unbounded_String;
		Input_Text : Unbounded_String;
		re : constant Pattern_Matcher := Compile("(<%((@\w+)|=)?(.*?)%>)|([""" & Ascii.HT & "])|($)", Multiple_Lines+Single_Line);
		Matches : Match_Array(0..5);
		Block_Type : Unbounded_String;
		Block_Text : Unbounded_String;
		Compile_Flags : Unbounded_String;
		Link_Flags : Unbounded_String;
		Declarations : Unbounded_String;
		Context_Clause : Unbounded_String;
		Current : Natural;
		End_Of_Quote : Natural;
		Timestamp : Ada.Calendar.Time;
		Directory_Entry : Ada.Directories.Directory_Entry_Type;
		C : Character;
	begin
		Timestamp := Ada.Directories.Modification_Time("webroot" & path & ".adasp");
		Put_Line("Reading input file");
		Open(Input_File, In_File, "webroot" & path & ".adasp");
		while not Ada.Text_IO.End_of_File(File => Input_File) loop
			Append(Input_Text, Ada.Text_IO.Get_Line(Input_File));
			Append(Input_Text, Ascii.LF);
		end loop;
		Close(Input_File);

		Current := 1;
		while Current < Length(Input_Text)
		loop
			Match(Re, To_String(Input_Text), Matches, Current);
			if Matches(0) = No_Match
			then
				Put_Line("No match");
				End_Of_Quote := Length(Input_Text);
			else
				Put_Line("Match at " & Natural'Image(Matches(0).First));
				End_Of_Quote := Matches(0).First-1;
			end if;
			Put_Line("Copying quote from " & Natural'Image(Current) & " to " & Natural'Image(End_Of_Quote) & ": """ & Slice(Input_Text, Current, End_Of_Quote) & """");
			Append(Adasp_Body, "  Ada.Strings.Unbounded.Append(Response_Data, Ada.Strings.Unbounded.To_Unbounded_String(""" & Slice(Input_Text, Current, End_Of_Quote) & """));" & Ascii.LF);
			if Matches(0) = No_Match
			then
				exit;
			elsif Matches(1).Last = Matches(1).First
			then
				Put_Line("Found char at " & Natural'Image(Matches(0).First));
				if Matches(5) = No_Match
				then
					Append(Adasp_Body, "  Ada.Strings.Unbounded.Append(Response_Data, Ascii.LF);" & Ascii.LF);
					Current := Matches(0).Last + 2;
				else
					C := Element(Input_Text, Matches(5).First);
					Put_Line("Found char " & C);
					case C is
						when '"' => Append(Adasp_Body, "  Ada.Strings.Unbounded.Append(Response_Data, Ada.Strings.Unbounded.To_Unbounded_String(""""""""));" & Ascii.LF);
						when Ascii.HT => Append(Adasp_Body, "  Ada.Strings.Unbounded.Append(Response_Data, Ascii.HT);" & Ascii.LF);
						when others => Append(Adasp_Body, "--unexpected char" & Ascii.LF);
					end case;
					Current := Matches(0).Last + 1;
				end if;
			else
				Put_Line("Found block from " & Natural'Image(Matches(1).First) & " to " & Natural'Image(Matches(1).Last));
				Block_Text := To_Unbounded_String(Slice(Input_Text, Matches(4).First, Matches(4).Last));
				if Matches(2) = No_Match
				then
					Append(Adasp_Body, Block_Text);
				else
					Block_Type := To_Unbounded_String(Slice(Input_Text, Matches(2).First, Matches(2).Last));
					if Block_Type = "="
					then
						Append(Adasp_Body, "  Ada.Strings.Unbounded.Append(Response_Data, Ada.Strings.Unbounded.To_Unbounded_String(" & Block_Text & "));" & Ascii.LF);
					elsif Block_Type = "@compile"
					then
						Append(Compile_Flags, Block_Text);
					elsif Block_Type = "@link"
					then
						Append(Link_Flags, Block_Text);
					elsif Block_Type = "@declare"
					then
						Append(Declarations, Block_Text);
					elsif Block_Type = "@context"
					then
						Append(Context_Clause, Block_Text);
					elsif Block_Type = "@with"
					then
						Append(Context_Clause, "with " & Block_Text & ";" & Ascii.LF);
					elsif Block_Type = "@use"
					then
						Append(Context_Clause, "use " & Block_Text & ";" & Ascii.LF);
					else
						-- Unknown @word
						Append(Adasp_Body, " -- Unknown @word: " & Block_Type & Ascii.LF);
					end if;
				end if;
				Current := Matches(0).Last+1;
			end if;
		end loop;
		Package_Name := To_Unbounded_String("temp_" & Ada.Strings.Fixed.Trim(Integer'Image(abs(RandInt.Random(Gen))), Ada.Strings.Left));
		Temp_Dir := "temp/" & Package_Name & "/";
		Ada.Directories.Create_Path(To_String(Temp_Dir));
		Ada.Directories.Create_Path(To_String(Temp_Dir & "obj"));
		Ada.Directories.Create_Path(To_String(Temp_Dir & "out"));
		O_Name := Temp_Dir & Package_Name & ".o";
		So_Name := Temp_Dir & "out/lib" & Package_Name & ".dylib";
		Adb_Name := Temp_Dir & Package_Name & ".adb";
		Ads_Name := Temp_Dir & Package_Name & ".ads";
		Gpr_Name := Temp_Dir & Package_Name & ".gpr";
		Create(Gpr_File, Out_File, To_String(Gpr_Name));
		Put(Gpr_File,
			"with ""aws"";" & Ascii.LF &
			"project " & To_String(Package_Name) & " is " & Ascii.LF &
			"  for Source_Dirs use (""."");" & Ascii.LF &
			"  for Object_Dir use ""obj"";" & Ascii.LF &
			"  for Library_Name use """ & To_String(Package_Name) & """;" & Ascii.LF &
			"  for Library_Dir use ""out"";" & Ascii.LF &
			"  for Library_Kind use ""dynamic"";" & Ascii.LF &
			"end " & To_String(Package_Name) & ";"
		);
		Close(Gpr_File);
		Create(Ads_File, Out_File, To_String(Ads_Name));
		Put(Ads_File,
			"with AWS; " & Ascii.LF &
			"with AWS.Status; " & Ascii.LF &
			"with AWS.Response; " & Ascii.LF &
			"Package " & To_String(Package_Name) & " is " & Ascii.LF &
			"  function Do_AdaSP (request : in AWS.Status.Data) return AWS.Response.Data; " & Ascii.LF &
			"  pragma Export_Function( " & Ascii.LF &
			"    Internal => Do_AdaSP, " & Ascii.LF &
			"    External => Do_AdaSP, " & Ascii.LF &
			"    Parameter_Types => (AWS.Status.Data) " & Ascii.LF &
			"  ); " & Ascii.LF &
			"end " & To_String(Package_Name) & "; "
		);
		Close(Ads_File);
		Create(Adb_File, Out_File, To_String(Adb_Name));
		Put(Adb_File,
			"with AWS; " & Ascii.LF &
			"with AWS.Status; " & Ascii.LF &
			"with AWS.Response; " & Ascii.LF &
			"with AWS.Resources; " & Ascii.LF &
			"with AWS.MIME; " & Ascii.LF &
			"with Ada.Strings.Unbounded; " & Ascii.LF &
			To_String(Context_Clause) & Ascii.LF &
			"Package body " & To_String(Package_Name) & " is " & Ascii.LF &
			"function Do_AdaSP (request : in AWS.Status.Data) return AWS.Response.Data is " & Ascii.LF &
			To_String(Declarations) & Ascii.LF &
			"  Response_Data : Ada.Strings.Unbounded.Unbounded_String;" & Ascii.LF &
			"begin " & Ascii.LF &
			To_String(Adasp_Body) &
			"  return AWS.Response.Build(AWS.MIME.Text_HTML, Ada.Strings.Unbounded.To_String(Response_Data));" & Ascii.LF &
			"end Do_AdaSP; " & Ascii.LF &
			"end " & To_String(Package_Name) & ";" & Ascii.LF
		);
		Close(Adb_File);

		Gnat_Root := To_Unbounded_String("/opt/gnat-2010-x86_64-apple-darwin9.6.0-bin");
		Aws_Root := To_Unbounded_String("/opt/gnat-2010-x86_64-apple-darwin9.6.0-bin/");

		Cmd := "cd temp/" & Package_Name & " && " & Gnat_Root & "/bin/gnatmake -gnat05 -P " & Package_Name & ".gpr";
		Put_Line(To_String(Cmd));
		Ret_Val := Sys(To_C(To_String(Cmd)));

		Dll.Open(Handle => Handle, Name => To_String(So_Name));
		Map_AdaSP(Handle => Handle, Name=>"do_adasp", Item => Do_Adasp);
		return new AdaSP'(To_Unbounded_String(Path), Timestamp, Handle, Do_Adasp);
	exception
	      when Dll.Dll_Exception => Put_Line("dll exception: " & Dll.Error(Handle));
		return null;
	end Build_AdaSP;

	function Hash(key : Unbounded_String) return Ada.Containers.Hash_Type is
	begin
		return Ada.Strings.Hash(To_String(Key));
	end Hash;
	function Eq_Keys(a,b : Unbounded_String) return Boolean is
	begin
		return a=b;
	end Eq_Keys;
	function Eq_Elems(a,b : AdaSP_Access) return Boolean is
	begin
		return a.path=b.path;
	end Eq_Elems;

	Package AdaSP_Table is new Ada.Containers.Hashed_Maps
	(
		Ada.Strings.Unbounded.Unbounded_String,
		AdaSP_Access,
		Hash,
		Eq_Keys,
		Eq_Elems
	);
	use AdaSP_Table;

	Cache : AdaSP_Table.Map;

	function Get_AdaSP_Function(Path : in String) return AWS.Response.Callback is
		AdaSP : AdaSP_Access;
		Timestamp : Ada.Calendar.Time;
	begin
		Timestamp := Ada.Directories.Modification_Time("webroot" & path & ".adasp");
		if Contains(Cache, To_Unbounded_String(Path))
		then
			AdaSP := element(Cache, To_Unbounded_String(Path));
			if Timestamp /= AdaSP.Timestamp
			then
				Dll.Close(AdaSP.Handle);
				AdaSP := Build_AdaSP(Path);
				Replace(Cache, To_Unbounded_String(Path), AdaSP);
			end if;
		else
			AdaSP := Build_AdaSP(Path);
			Insert(Cache, To_Unbounded_String(Path), AdaSP);
		end if;
		return AdaSP.Do_Adasp;
	end Get_AdaSP_Function;

	function Callback(request : In AWS.Status.Data) return AWS.Response.Data is
		Do_Adasp : AWS.Response.Callback;
	begin
		Do_AdaSP := Get_Adasp_Function(AWS.Status.URI(request));
		if Do_AdaSP /= null
		then
			return Do_AdaSP(request);
		else
			return AWS.Response.Build(AWS.MIME.Text_HTML, "error");
		end if;
	end Callback;
	
	S : Ada.Strings.Unbounded.Unbounded_String;
begin
	RandInt.Reset(Gen);
	s := Ada.Strings.Unbounded.Null_Unbounded_String;
	AWS.Server.Start(WS, "Ada Server Pages Server", Callback'Unrestricted_Access);
	AWS.Server.Wait;
end AdaSP_Serv;
